-- Copyright (c) 2016-present, Facebook, Inc.
-- All rights reserved.
--
-- This source code is licensed under the BSD-style license found in the
-- LICENSE file in the root directory of this source tree.


{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module Duckling.Time.Corpus
  ( datetime
  , datetimeHoliday
  , datetimeInterval
  , datetimeIntervalHoliday
  , datetimeOpenInterval
  , examples
  ) where

import Data.Aeson
import Data.Text (Text)
import Prelude
import Data.String
import qualified Data.Aeson.KeyMap as K
import qualified Data.Time.LocalTime.TimeZone.Series as Series

import Duckling.Resolve
import Duckling.Testing.Types hiding (examples)
import Duckling.Time.Types hiding (Month)
import Duckling.TimeGrain.Types hiding (add)
import Duckling.Types hiding (Entity(..))

datetime :: Datetime -> Grain -> Context -> TimeValue
datetime d g ctx = datetimeIntervalHolidayHelper (d, Nothing) g Nothing ctx

datetimeHoliday :: Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday d g h ctx =
  datetimeIntervalHolidayHelper (d, Nothing) g (Just h) ctx

datetimeInterval :: (Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval (d1, d2) g ctx =
  datetimeIntervalHolidayHelper (d1, Just d2) g Nothing ctx

datetimeIntervalHoliday ::
  (Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday (d1, d2) g h ctx =
  datetimeIntervalHolidayHelper (d1, Just d2) g (Just h) ctx

datetimeIntervalHolidayHelper ::
  (Datetime, Maybe Datetime) -> Grain -> Maybe Text -> Context -> TimeValue
datetimeIntervalHolidayHelper (d1, md2) g hol ctx = TimeValue tv [tv] hol
  where
    DucklingTime (Series.ZoneSeriesTime _ tzSeries) = referenceTime ctx
    tv = timeValue tzSeries TimeObject {start = dt d1, end = d, grain = g}
    d = case md2 of
      Nothing -> Nothing
      Just d2 -> Just $ dt d2

datetimeOpenInterval
  :: IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval dir d g ctx = TimeValue tv [tv] Nothing
  where
    DucklingTime (Series.ZoneSeriesTime _ tzSeries) = referenceTime ctx
    tv = openInterval tzSeries dir TimeObject
      {start = dt d, end = Nothing, grain = g}


check :: ToJSON a => (Context -> a) -> TestPredicate
check f context Resolved{rval = RVal _ v} = case toJSON v of
  Object o -> deleteValues (toJSON (f context)) == deleteValues (Object o)
  _ -> False
  where
    deleteValues :: Value -> Value
    deleteValues (Object o) = Object $ K.delete "values" o
    deleteValues _ = Object K.empty

examples :: ToJSON a => (Context -> a) -> [Text] -> [Example]
examples f = examplesCustom (check f)
